{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Orche.Language.SignalModifiers
-- Copyright   :  (c) Stephen Tetley 2012-2013
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Signal modifying opcodes.
-- 
--------------------------------------------------------------------------------

module Ochre.Language.SignalModifiers
  (


  -- * Standard filters
    portk
  , port   -- Csound port
  , tonek
  , tone
  , atonek
  , atone
  , resonk
  , reson
  , aresonk
  , areson
  , tonex
  , atonex
  , resonx
  , resonr
  , resonz
  , resony
  , lowres
  , lowresx
  , vlowres
  , lowpass2
  , hilbert
  , butterhp
  , butterhp_
  , butterlp
  , butterlp_
  , butterbp
  , butterbp_
  , butterbr
  , butterbr_


  -- * Specialized filters
  , nlfilt
  , pareq
  , dcblock
  , dcblock_

  -- * Envelope modifiers
  , linen
  , linenr
  , envlpx
  , envlpxr

  -- * Amplitude modifiers
  , rms
  , rms_
  , gain
  , balance
  , dam

  -- * signal limiters
  , wrap
  , mirror
  , limit

  -- * Delay
  , delayr
  , delayw
  , delay
  , delay1
  , deltap
  , deltapi
  , deltapn
  , deltap3

  , multitap
  , vdelay
  , vdelay3

  -- * Reverbaration
  , reverb
  , reverb2
  , nreverb
  , comb
  , alpass
  , babo
  , nestedap
  , reverbsc

  -- * Panning and spatialization
  , pan
  , pan2
  , locsig
  , locsig2


  ) where

import Ochre.Language.Prim


--------------------------------------------------------------------------------
-- Standard filters


portk :: KSig -> KSig -> GenKSig
portk ksig khtim = 
    opcode1 "portk" [ getPValue ksig, getPValue khtim ]



port :: KSig -> ISig -> GenKSig
port ksig ihtim = 
    opcode1 "port" [ getPValue ksig, getPValue ihtim ]


tonek :: KSig -> KSig -> GenKSig
tonek ksig khp = 
    opcode1 "tonek" [ getPValue ksig, getPValue khp ]


tone :: ASig -> KSig -> GenASig
tone asig khp = 
    opcode1 "tone" [ getPValue asig, getPValue khp ]

atonek :: KSig -> KSig -> GenKSig
atonek ksig khp = 
    opcode1 "atonek" [ getPValue ksig, getPValue khp ]

atone :: ASig -> KSig -> GenASig
atone asig khp = 
    opcode1 "atone" [ getPValue asig, getPValue khp ]

resonk :: KSig -> KSig -> KSig -> GenKSig
resonk ksig kcf kbw = 
    opcode1 "resonk" [ getPValue ksig, getPValue kcf
                     , getPValue kbw ]

reson :: ASig -> KSig -> KSig -> GenASig
reson asig kcf kbw = 
    opcode1 "reson" [ getPValue asig, getPValue kcf
                    , getPValue kbw ]

aresonk :: KSig -> KSig -> KSig -> GenKSig
aresonk ksig kcf kbw = 
    opcode1 "aresonk" [ getPValue ksig, getPValue kcf
                      , getPValue kbw ]

areson :: ASig -> KSig -> KSig -> GenASig
areson asig kcf kbw = 
    opcode1 "areson" [ getPValue asig, getPValue kcf
                     , getPValue kbw ]


tonex :: ASig -> KSig -> GenASig
tonex asig khp = 
    opcode1 "tonex" [ getPValue asig, getPValue khp ]

atonex :: ASig -> KSig -> GenASig
atonex asig khp = 
    opcode1 "atonex" [ getPValue asig, getPValue khp ]


resonx :: ASig -> KSig -> KSig -> GenASig
resonx asig kcf kbw = 
    opcode1 "resonx" [ getPValue asig, getPValue kcf
                     , getPValue kbw ]

resonr :: ASig -> KSig -> KSig -> GenASig
resonr asig kcf kbw = 
    opcode1 "resonr" [ getPValue asig, getPValue kcf
                     , getPValue kbw ]

resonz :: ASig -> KSig -> KSig -> GenASig
resonz asig kcf kbw = 
    opcode1 "resonz" [ getPValue asig, getPValue kcf
                     , getPValue kbw ]

resony :: ASig -> KSig -> KSig -> IInt -> KSig -> GenASig
resony asig kbf kbw inum ksep = 
    opcode1 "resony" [ getPValue asig, getPValue kbf
                     , getPValue kbw,  getPValue inum
                     , getPValue ksep ]

lowres :: ASig -> KSig -> KSig -> GenASig
lowres asig kcutoff kresonance = 
    opcode1 "lowres" [ getPValue asig, getPValue kcutoff
                     , getPValue kresonance ]

lowresx :: ASig -> KSig -> KSig -> GenASig
lowresx asig kcutoff kresonance = 
    opcode1 "lowresx" [ getPValue asig, getPValue kcutoff
                      , getPValue kresonance ]


-- | Note @iord@ could be a var representing a pfield rather than 
-- always an @Int@...
--
vlowres :: ASig -> KSig -> KSig -> IInt -> KSig -> GenASig
vlowres asig kfco kres iord ksep = 
    opcode1 "vlowres" [ getPValue asig, getPValue kfco
                      , getPValue kres, getPValue iord
                      , getPValue ksep ]


lowpass2 :: ASig -> KSig -> KSig -> GenASig
lowpass2 asig kef kq = 
    opcode1 "lowpass2" [ getPValue asig, getPValue kef
                       , getPValue kq ]


hilbert :: ASig -> GenSig2 ARate
hilbert asig = 
    opcode2 "hilbert" [ getPValue asig ]

butterhp :: ASig -> KSig -> GenASig
butterhp asig kfreq = 
    opcode1 "butterhp" [ getPValue asig, getPValue kfreq ]

-- Int used a boolean...
--
butterhp_ :: ASig -> KSig -> IInt -> GenASig
butterhp_ asig kfreq isep = 
    opcode1 "butterhp" [ getPValue asig, getPValue kfreq
                       , getPValue isep ]


butterlp :: ASig -> KSig -> GenASig
butterlp asig kfreq = 
    opcode1 "butterlp" [ getPValue asig, getPValue kfreq ]

butterlp_ :: ASig -> KSig -> IInt -> GenASig
butterlp_ asig kfreq iskip = 
    opcode1 "butterlp" [ getPValue asig, getPValue kfreq
                       , getPValue iskip ]

butterbp :: ASig -> KSig -> KSig -> GenASig
butterbp asig kfreq kband = 
    opcode1 "butterbp" [ getPValue asig, getPValue kfreq
                       , getPValue kband ]


butterbp_ :: ASig -> KSig -> KSig -> IInt -> GenASig
butterbp_ asig kfreq kband iskip = 
    opcode1 "butterbp" [ getPValue asig,  getPValue kfreq
                       , getPValue kband, getPValue iskip ]

butterbr :: ASig -> KSig -> KSig -> GenASig
butterbr asig kfreq kband = 
    opcode1 "butterbr" [ getPValue asig, getPValue kfreq
                       , getPValue kband ]

butterbr_ :: ASig -> KSig -> KSig -> IInt -> GenASig
butterbr_ asig kfreq kband iskip = 
    opcode1 "butterbr" [ getPValue asig,  getPValue kfreq
                       , getPValue kband, getPValue iskip ]


--------------------------------------------------------------------------------
-- Specialized filters


nlfilt :: ASig -> KSig -> KSig 
       -> KSig -> KSig -> KSig 
       -> GenASig
nlfilt ain ka kb kd kL kC = 
    opcode1 "nlfilt" [ getPValue ain, getPValue ka
                     , getPValue kb,  getPValue kd
                     , getPValue kL,  getPValue kC ]

pareq :: ASig -> KSig -> KSig 
      -> KSig -> IInt -> IInt 
      -> GenASig
pareq asig kc kv kq imode iskip = 
    opcode1 "pareq" [ getPValue asig,  getPValue kc
                    , getPValue kv,    getPValue kq
                    , getPValue imode, getPValue iskip ]

dcblock :: ASig -> GenASig
dcblock asig = 
    opcode1 "dcblock" [ getPValue asig ]

dcblock_ :: ASig -> IFloat -> GenASig
dcblock_ asig ig = 
    opcode1 "dcblock" [ getPValue asig, getPValue ig ]

--------------------------------------------------------------------------------
-- Envelope modifiers


linen :: IKA_Signal a
      => Sig a -> IFloat -> IFloat -> IFloat -> GenSig a
linen xamp irise idur idec = 
    opcode1 "linen" [ getPValue xamp, getPValue irise
                    , getPValue idur, getPValue idec ]

linenr :: IKA_Signal a
       => Sig a -> IFloat -> IFloat -> IFloat -> GenSig a
linenr xamp irise idec iatdec = 
    opcode1 "linenr" [ getPValue xamp, getPValue irise
                     , getPValue idec, getPValue iatdec ]

envlpx :: (IKA_Signal a, IKA_Signal r1)
       => Sig r1 -> IFloat -> IFloat -> IFloat 
       -> TableIx -> IFloat -> IFloat 
       -> GenSig a
envlpx xamp irise idur idec ifn iatss iatdec = 
    opcode1 "envlpx" [ getPValue xamp, getPValue irise
                     , getPValue idur, getPValue idec
                     , getPValue ifn,  getPValue iatss
                     , getPValue iatdec ]


envlpxr :: IKA_Signal a
        => Sig a -> IFloat -> IFloat 
        -> IFloat  -> IInt -> IFloat -> IFloat 
        -> GenSig a
envlpxr xamp irise idur idec ifn iatss iatdec = 
    opcode1 "envlpxr" [ getPValue xamp, getPValue irise
                      , getPValue idur, getPValue idec
                      , getPValue ifn,  getPValue iatss
                      , getPValue iatdec ]

--------------------------------------------------------------------------------
-- Amplitude modifiers


rms :: ASig -> GenKSig
rms asig =
    opcode1 "rms" [ getPValue asig ]

rms_ :: ASig -> IFloat -> IFloat -> GenKSig
rms_ asig ihp iskip = 
    opcode1 "rms" [ getPValue asig, getPValue ihp
                  , getPValue iskip ]

gain :: ASig -> KSig -> GenASig
gain asig krms = 
    opcode1 "gain" [ getPValue asig, getPValue krms ]

balance :: ASig -> ASig -> GenASig
balance asig acomp = 
    opcode1 "balance" [ getPValue asig, getPValue acomp ]

dam :: ASig -> KSig 
    -> IFloat -> IFloat -> IFloat -> IFloat 
    -> GenASig
dam ain kthreshold icomp1 icomp2 rtime ftime = 
    opcode1 "dam" [ getPValue ain,    getPValue kthreshold
                  , getPValue icomp1, getPValue icomp2
                  , getPValue rtime,  getPValue ftime ]

--------------------------------------------------------------------------------
-- Signal limiters


wrap :: IKA_Signal a => Sig a -> Sig a -> Sig a -> GenSig a
wrap xsig xlow xhigh = 
    opcode1 "wrap" [ getPValue xsig, getPValue xlow
                   , getPValue xhigh ]


mirror :: IKA_Signal a => Sig a -> Sig a -> Sig a -> GenSig a
mirror xsig xlow xhigh = 
    opcode1 "mirror" [ getPValue xsig, getPValue xlow
                     , getPValue xhigh ]

limit :: IKA_Signal a => Sig a -> Sig a -> Sig a -> GenSig a
limit xsig xlow xhigh = 
    opcode1 "limit" [ getPValue xsig, getPValue xlow
                    , getPValue xhigh ]


--------------------------------------------------------------------------------
-- Delay


delayr :: IFloat -> GenASig
delayr idlt = 
    opcode1 "delayr" [ getPValue idlt ]

-- | No answer ... sure?
delayw :: ASig -> Code ()
delayw asigar = 
    opcode0 "delayw" [ getPValue asigar ]

delay :: ASig -> IFloat -> GenASig
delay asig idlt = 
    opcode1 "delay" [ getPValue asig, getPValue idlt ]

delay1 :: ASig -> GenASig
delay1 asig = 
    opcode1 "delay1" [ getPValue asig ]

deltap :: KSig -> GenASig
deltap kdlt = 
    opcode1 "deltap" [ getPValue kdlt ]

-- | xdlt is seconds, but it can be a signal...
--
deltapi :: IKA_Signal a => Sig a -> GenASig
deltapi xdlt = 
    opcode1 "deltapi" [ getPValue xdlt ]

-- | xnumsamps is presumably an integer...
--
deltapn :: IKA_Signal a => Sig a -> GenASig
deltapn xnumsamps = 
    opcode1 "deltapn" [ getPValue xnumsamps ]


-- | xdlt is seconds...
--
deltap3 :: IKA_Signal a => Sig a -> GenASig
deltap3 xdlt = 
    opcode1 "deltap3" [ getPValue xdlt ]

-- | Genuine list - not an envelope...
--
multitap :: ASig -> [(IFloat, IFloat)] -> GenASig
multitap asig xs = opcode1 "multitap"  (getPValue asig : rest) 
  where
    rest = concatMap (\(a,b) -> [getPValue a, getPValue b]) xs
     


vdelay :: ASig -> ASig -> IFloat -> GenASig
vdelay asig adel imaxdel = 
    opcode1 "vdelay" [ getPValue asig,   getPValue adel
                     , getPValue imaxdel ]

vdelay3 :: ASig -> ASig -> IFloat -> GenASig
vdelay3 asig adel imaxdel = 
    opcode1 "vdelay3" [ getPValue asig,   getPValue adel
                      , getPValue imaxdel ]

--------------------------------------------------------------------------------
-- Reverberation


reverb :: ASig -> KSig -> GenASig
reverb asig kvrt = 
    opcode1 "reverb" [ getPValue asig, getPValue kvrt ]

reverb2 :: ASig -> KSig -> KSig -> GenASig
reverb2 asig ktime khdif = 
    opcode1 "reverb2" [ getPValue asig, getPValue ktime
                      , getPValue khdif ]

nreverb :: ASig -> KSig -> KSig -> GenASig
nreverb asig ktime khdif = 
    opcode1 "nreverb" [ getPValue asig, getPValue ktime
                      , getPValue khdif ]

comb :: ASig -> KSig -> IFloat -> GenASig
comb asig krvt ilpt = 
    opcode1 "comb" [ getPValue asig, getPValue krvt
                   , getPValue ilpt ]

alpass :: ASig -> KSig -> IFloat -> GenASig
alpass asig krvt ilpt = 
    opcode1 "alpass" [ getPValue asig, getPValue krvt
                     , getPValue ilpt ]

babo :: ASig -> KSig -> KSig -> KSig -> IFloat -> IFloat -> IFloat 
     -> GenSig2 ARate
babo asig ksrcx ksrcy ksrcz irx iry irz =
    opcode2 "babo" [ getPValue asig,  getPValue ksrcx
                   , getPValue ksrcy, getPValue ksrcz
                   , getPValue irx,   getPValue iry
                   , getPValue irz ]

nestedap :: ASig -> IFloat -> IFloat -> IFloat -> IFloat -> GenASig
nestedap asig imode imaxdel idel1 igain1 = 
    opcode1 "nestedap" [ getPValue asig,    getPValue imode
                       , getPValue imaxdel, getPValue idel1
                       , getPValue igain1 ]



reverbsc :: ASig -> ASig -> KSig -> KSig -> GenSig2 ARate
reverbsc ainL ainR kfblvl kfco = 
    opcode2 "reverbsc" [ getPValue ainL,   getPValue ainR
                       , getPValue kfblvl, getPValue kfco ]

--------------------------------------------------------------------------------
-- Panning and spatialization

-- Note - name /priority/ is given to the 4 channel versions.


-- | 4 channel pan.
--
-- 1 Table fn.
--
pan :: ASig -> KSig -> KSig -> TableIx -> GenSig4 ARate
pan asig kx ky ifn = 
    opcode4 "pan" [ getPValue asig, getPValue kx
                  , getPValue ky,   getPValue ifn ]


pan2 :: IKA_Signal a => ASig -> Sig a -> GenSig2 ARate
pan2 asig xp = 
    opcode2 "pan2" [ getPValue asig, getPValue xp ]


-- | 4 channel version of locsig.
--
locsig :: ASig -> KSig -> KSig -> KSig -> GenSig4 ARate
locsig asig kdegree kdistance kreverbsend = 
    opcode4 "locsig" [ getPValue asig,      getPValue kdegree
                     , getPValue kdistance, getPValue kreverbsend ]


-- | This is the 2 channel version of 'locsig'
--
locsig2 :: ASig -> KSig -> KSig -> KSig -> GenSig2 ARate
locsig2 asig kdegree kdistance kreverbsend = 
    opcode2 "locsig" [ getPValue asig,      getPValue kdegree
                     , getPValue kdistance, getPValue kreverbsend ]

